library CAB;


uses
  FastShareMem,
  SysUtils,
  Classes,
  Windows,
  Math,
  Graphics;

{$R *.res}

type
  TIntegerArray = array of Integer;
  TSCARPlugFunc = record
    Name: string;
    Ptr: Pointer;
  end;

  TOneStrProc = procedure(s: string);

var
  Writeln: TOneStrProc;

procedure QuickSort(var A: TIntegerArray; iLo, iHi: Integer; SortUp: Boolean);
var
  Lo, Hi, Mid, T: Integer;
  
begin
  Lo := iLo;
  Hi := iHi;
  Mid := A[(Lo + Hi) shr 1];
  repeat
    if SortUp then
    begin
      while (A[Lo] < Mid) do Inc(Lo);
      while (A[Hi] > Mid) do Dec(Hi);
    end else
    begin
      while (A[Lo] > Mid) do Inc(Lo);
      while (A[Hi] < Mid) do Dec(Hi);
    end;
    if (Lo <= Hi) then
    begin
      T := A[Lo];
      A[Lo] := A[Hi];
      A[Hi] := T;
      Inc(Lo);
      Dec(Hi);
    end;
  until Lo > Hi;
  if (Hi > iLo) then QuickSort(A, iLo, Hi, SortUp);
  if (Lo < iHi) then QuickSort(A, Lo, iHi, SortUp);
end;

function RGBToColor(R, G, B: Integer): TColor;
begin
  Result := (R or G shl 8 or b shl 16);
end;

procedure ColorToRGB(Color: TColor; var R, G, B: Integer);
begin
  R := Color and $ff;
  G := (Color and $ff00) shr 8; 
  B := (Color and $ff0000) shr 16;
end;

function CAB_SortColorsArr(Colors: TIntegerArray; WhiteFirst: Boolean): TIntegerArray; stdcall;
var
  i, c, L: Integer;
  R, G, B, M: TIntegerArray;

begin
  Result := nil;
  L := Length(Colors);
  SetLength(Result, L);
  SetLength(R, L);
  SetLength(G, L);
  SetLength(B, L);
  SetLength(M, L);
  Dec(L);
  for i := 0 to L do
  begin
    ColorToRGB(Colors[i], R[i], G[i], B[i]);
    M[i] := R[i]+G[i]+B[i];
  end;
  QuickSort(M, Low(Colors), High(Colors), not(WhiteFirst));
  for i := 0 to L do
   for c := 0 to L do
     if ((R[c] + G[c] + B[c]) = M[i]) then
       Result[i] := RGBToColor(R[c], G[c], B[c]);
end;

function CAB_GradientBitmap(Width, Height, Colour: Integer; Saturation: Extended): TBitmap; stdcall;
var
  w, h: Integer;
  R, RR, G, GG, B, BB: Integer;

begin
  try
    if Saturation > 1 then RaiseLastOSError;
    Result := TBitmap.Create;
    Result.Width := Width;
    Result.Height := Height;
    ColorToRGB(Colour, R, G, B);
    for w := 0 to Width do
      for h := 0 to Height do
      begin
        RR := Round((h / Height) * (R * Saturation));
        GG := Round((h / Height) * (G * Saturation));
        BB := Round((h / Height) * (B * Saturation));
        Result.Canvas.Pixels[w, h] := RGBToColor(R - RR, G - GG, B - BB);
      end;
  except
    Result := nil;
  end;
end;

function CAB_ColourBitmap(Width, Height, Colour: Integer): TBitmap; stdcall;
begin
  Result := CAB_GradientBitmap(Width, Height, Colour, 0.0);
end;

function CAB_LightenBitmap(BMPHandle: HDC; Width, Height, Percent: Integer): TBitmap; stdcall;
var
  R, G, B, w, h: Integer;

begin
  Result := TBitmap.Create;
  Result.Width := Width;
  Result.Height:= Height;
  BitBlt(Result.Canvas.Handle, 0, 0, Width, Height, BMPHandle, 0, 0, SRCCOPY);
  for w := 0 to Width do
    for h := 0 to Height do
    begin
      ColorToRGB(Result.Canvas.Pixels[w, h], R, G, B);
      R := R+Round((Percent / 100.0)*(255-R));
      G := G+Round((Percent / 100.0)*(255-G));
      B := B+Round((Percent / 100.0)*(255-B));
      Result.Canvas.Pixels[w, h] := RGBToColor(R, G, B);
    end;
end;

function CAB_DarkenBitmap(BMPHandle: HDC; Width, Height, Percent: Integer): TBitmap; stdcall;
var
  R, G, B, w, h: Integer;

begin
  Result := TBitmap.Create;
  Result.Width := Width;
  Result.Height := Height;
  BitBlt(Result.Canvas.Handle, 0, 0, Width, Height, BMPHandle, 0, 0, SRCCOPY);
  for w := 0 to Width do
    for h := 0 to Height do
    begin
      ColorToRGB(Result.Canvas.Pixels[w, h], R, G, B);
      R := R-Round((Percent / 100.0)*R);
      G := G-Round((Percent / 100.0)*G);
      B := B-Round((Percent / 100.0)*B);
      Result.Canvas.Pixels[w, h] := RGBToColor(R, G, B);
    end;
end;

function CAB_NegativeBitmap(BMPHandle: HDC; Width, Height: Integer): TBitmap; stdcall;
var
  w, h, R, G, B: Integer;

begin
  Result := TBitmap.Create;
  Result.Width := Width;
  Result.Height := Height;
  BitBlt(Result.Canvas.Handle, 0, 0, Width, Height, BMPHandle, 0, 0, SRCCOPY);
  for w := 0 to Width do
    for h := 0 to Height do
    begin
      ColorToRGB(Result.Canvas.Pixels[w, h], R, G, B);
      Result.Canvas.Pixels[w, h] := RGBToColor(255 - R, 255 - G, 255 - B);
    end;
end;

function CAB_GreystyleBitmap(BMPHandle: HDC; Width, Height: Integer): TBitmap; stdcall;
var
  w, h, R, G, B, I: Integer;

begin
  Result := TBitmap.Create;
  Result.Width := Width;
  Result.Height := Height;
  BitBlt(Result.Canvas.Handle, 0, 0, Width, Height, BMPHandle, 0, 0, SRCCOPY);
  for w := 0 to Width do
    for h := 0 to Height do
    begin
      ColorToRGB(Result.Canvas.Pixels[w, h], R, G, B);
      I := Round((R + G + B)/3);
      Result.Canvas.Pixels[w, h] := RGBToColor(I, I, I);
    end;
end;

function GetFunctionCount(): Integer; stdcall; export;
begin
  Result := 7;
end;

function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
  case x of
    0:
      begin
        ProcAddr := @CAB_SortColorsArr;
        StrPCopy(ProcDef, 'function CAB_SortColorsArr(Colors: TIntegerArray; WhiteFirst: Boolean): TIntegerArray;');
      end;
    1:
      begin
        ProcAddr := @CAB_GradientBitmap;
        StrPCopy(ProcDef, 'function CAB_GradientBitmap(Width, Height, Colour: Integer; Saturation: Extended): TBitmap;');
      end;
    2:
      begin
        ProcAddr := @CAB_ColourBitmap;
        StrPCopy(ProcDef, 'function CAB_ColourBitmap(Width, Height, Colour: Integer): TBitmap;');
      end;
    3:
      begin
        ProcAddr := @CAB_LightenBitmap;
        StrPCopy(ProcDef, 'function CAB_LightenBitmap(BMPHandle: HDC; Width, Height, Percent: Integer): TBitmap;');
      end;
    4:
      begin
        ProcAddr := @CAB_DarkenBitmap;
        StrPCopy(ProcDef, 'function CAB_DarkenBitmap(BMPHandle: HDC; Width, Height, Percent: Integer): TBitmap;');
      end;
    5:
      begin
        ProcAddr := @CAB_NegativeBitmap;
        StrPCopy(ProcDef, 'function CAB_NegativeBitmap(BMPHandle: HDC; Width, Height: Integer): TBitmap;');
      end;
    6:
      begin
        ProcAddr := @CAB_GreystyleBitmap;
        StrPCopy(ProcDef, 'function CAB_GreystyleBitmap(BMPHandle: HDC; Width, Height: Integer): TBitmap;');
      end;
  else
    x := -1;
  end;
  Result := x;
end;

procedure SetFunctions(Funcs: array of TSCARPlugFunc); stdcall;
var
  i: Integer;
begin
  for i := 0 to Length(Funcs) - 1 do
    if Funcs[i].Name = 'Writeln' then
      Writeln := Funcs[i].Ptr;
end;

exports GetFunctionCount;
exports GetFunctionInfo;
exports SetFunctions;

end.
